home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / roman.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-12-17  |  966 b   |  23 lines
  1. 100  SCREEN 0,1:WIDTH 80:COLOR 11,4,4:CLS:PROGRAM$="ROMAN"
  2. 110  PRINT TAB(13) "Enter a number between 1 and 4999999, or 0 to end":COLOR 14
  3. 120  PRINT:PRINT TAB(24) "Arabic        Roman" TAB(24) "THENTHENTHENTHENTHENTHEN        THENTHENTHENTHENTHEN"
  4. 130  DEF SEG=&H40:POKE &H17,(PEEK(&H17) OR &H20):DEF SEG  'numlock on
  5. 140  DIM ARAB!(25),ROM$(25): FOR X=1 TO 16: READ ARAB!(X),ROM$(X): NEXT X
  6. 160  FOR X=17 TO 25:ARAB!(X)=ARAB!(X-12)*1000:ROM$(X)=ROM$(X-12):NEXT X
  7. 170  LOCATE 5:COLOR 15
  8. 180  WHILE 1>0              'endless loop
  9. 190    PRINT:INPUT;"                       ",NUMB:LOCATE ,38
  10. 200    IF NUMB=0 THEN DEF SEG=&H40:POKE &H17,(PEEK(&H17) AND &HDF):END  'quit
  11. 210    IF NUMB>5E+06 THEN PRINT "Larger than ";:NUMB=5E+06
  12. 220    FOR X=25 TO 1 STEP -1
  13. 230      WHILE NUMB>=ARAB!(X):PRINT ROM$(X);:NUMB=NUMB-ARAB!(X)
  14. 240        IF ARAB!(X)<9001 THEN CAP$="_" ELSE CAP$=STRING$(LEN(ROM$(X)),"_")
  15. 250        L=CSRLIN: P=POS(N)-LEN(CAP$)
  16. 260        IF ARAB!(X)>3999 THEN LOCATE L-1,P:PRINT CAP$;:LOCATE L
  17. 270      WEND
  18. 280    NEXT X
  19. 290    PRINT
  20. 300  WEND
  21. 310  DATA 1,"I",4,"IV",5,"V",9,"IX",10,"X",40,"XL",50,"L",90,"XC",100,"C"
  22. 320  DATA 400,"CD",500,"D",900,"CM",1000,"M",4000,"MV",5000,"V",9000,"MX"
  23.